home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mvaders / mvaders.bas < prev    next >
BASIC Source File  |  1997-11-04  |  29KB  |  1,050 lines
  1. Option Explicit
  2.  
  3. 'Game Constants
  4. '~~~~~~~~~~~~~~
  5. 'Flags for monitoring movement keys
  6. Global Const KEY_CUR_LEFT_FLAG = 1
  7. Global Const KEY_CUR_RIGHT_FLAG = 2
  8. Global Const KEY_FIRE_FLAG = 4
  9.  
  10. 'KeyCode values for important keys
  11. Global Const KEY_CUR_LEFT = 37
  12. Global Const KEY_CUR_RIGHT = 39
  13. Global Const KEY_FIRE = 32
  14. Global Const KEY_ABORT = 65
  15. Global Const KEY_PAUSE = 80
  16. Global Const KEY_QUIT = 81
  17.  
  18. 'Game status
  19. Global Const GAME_PLAYING = 0
  20. Global Const GAME_STOPPED = 1
  21. Global Const GAME_PAUSED = 2
  22.  
  23. 'Sprite ID's
  24.  
  25. Global Const PLAYER_ID = 0
  26. Global Const BULLET_ID = 1
  27. Global Const FIRST_INVADER_ID = 2
  28. Global Const LAST_INVADER_ID = 31
  29. Global Const BONUS_SHIP_ID = 32
  30. Global Const FIRST_INVADER_BULLET_ID = 33
  31. Global Const LAST_INVADER_BULLET_ID = 35
  32. Global Const EXPLOSION_ID = 36
  33. Global Const BOSS_ID = 37
  34.  
  35. 'How many points until an extra life is granted
  36. Global Const EXTRA_LIFE = 500
  37. Global Const START_LIVES = 3
  38. Global Const MAX_LIVES = 5
  39.  
  40. 'Odd VB costants
  41. Global Const VBModal = 1        'To diaplay forms as Modal
  42.  
  43. 'Windows API rectangle structure
  44. Type RECT
  45.     iLeft As Integer
  46.     iTop As Integer
  47.     iRight As Integer
  48.     iBottom As Integer
  49. End Type
  50.  
  51. 'Windows API Point structure
  52. Type POINTAPI
  53.     iX As Integer
  54.     iY As Integer
  55. End Type
  56.  
  57. 'Constants for BitBlt() copy modes
  58. Global Const SRCCOPY = &HCC0020
  59. Global Const SRCAND = &H8800C6
  60. Global Const SRCPAINT = &HEE0086
  61. Global Const NOTSRCCOPY = &H330008
  62. Global Const SRCERASE = &H440328
  63. Global Const SRCINVERT = &H660046
  64.  
  65. 'Constants for objects Scale Mode
  66. Global Const TWIPS = 1
  67. Global Const PIXELS = 3
  68. Global Const RES_INFO = 2
  69. Global Const MINIMIZED = 1
  70.  
  71. Global Const SND_ASYNC = &H1
  72.  
  73. 'My User Defined Types
  74. '~~~~~~~~~~~~~~~~~~~~~
  75.  
  76. 'Defines an image in loaded gfx bitmap
  77. Type VBGfx
  78.     iX As Integer           'TopLeft of this gfx
  79.     iY As Integer           'TopRight of this gfx
  80.     iW As Integer           'Width
  81.     iH As Integer           'Height
  82. End Type
  83.  
  84. 'Defines a sprite on the screen
  85. Type VBSprite
  86.     iInUse As Integer       'Set if sprite is being used
  87.     iActive As Integer      '0=Sprite is off, 1=Sprite is on
  88.     iSaveOn As Integer      '0=No saves, 1=wipe as we go, 2=Bgrnd save
  89.     iGfxX As Integer        'X position of sprite in Gfx bitmap (pixel coords)
  90.     iGfxY As Integer        'Y position of sprite in Gfx bitmap (pixel coords)
  91.     iTrans As Integer       'Set if doing transparent blits
  92.     iW As Integer           'Width of the sprite
  93.     iH As Integer           'Height of the sprite
  94.     iX As Integer           'X position of sprite (pixel coords)
  95.     iY As Integer           'Y position of sprite (pixel coords)
  96.     lColour As Long         'Background colour if wiping & not restoring background
  97.     iSaveDC As Integer      'DC for background save
  98.     iSaveBmp As Integer     'BitMap for background save
  99.     iSaveSav As Integer     'BitMap from DC
  100.     iUser1 As Integer       'Varies according to sprite type
  101. End Type
  102.  
  103. 'Game preferences
  104. Type prefs
  105.     iTimer As Integer       'Timer value that controls game loop
  106.     iIGap As Integer        'Invaders separation
  107.     iISpeed As Integer      'Invaders initial speed
  108.     iIBSpeed As Integer     'Invaders bullet speed
  109.     fIBFreq As Single       'Invaders bullet frequency
  110.     iIDrop As Integer       'Invaders drop rate
  111.     iPSpeed As Integer      'Players speed
  112.     iPBSpeed As Integer     'Players bullet speed
  113. End Type
  114.  
  115. 'Game Global Variables
  116. '~~~~~~~~~~~~~~~~~~~~~
  117.  
  118. Global giKeyStatus As Integer   'Holds movement key flags
  119. Global giGameStatus As Integer  'Playing, Paused or Stopped
  120. Global giLevel As Integer       'What level player is on
  121. Global giLives As Integer       'How many lives the player has left
  122. Global giScore As Integer       'Players score
  123. Global giHiScore As Integer     'Highest Score
  124. Global gsHiName As String * 20  'Name of player with high score
  125. Global giFiring As Integer      'Set when player has fired a bullet
  126. Global giInvaders As Integer    'Number of invaders left to kill
  127. Global giFireLock As Integer    'Set to disable fire button detection
  128. Global GamePrefs As prefs       'Game preferences
  129.  
  130. 'Invaders graphics
  131. Dim miGfxDC As Integer
  132. Dim miGfxBmp As Integer
  133. Dim miGfxSav  As Integer
  134. Dim miMaskDC As Integer
  135. Dim miMaskBmp As Integer
  136. Dim miMaskSav As Integer
  137. Dim mVBGfx(22) As VBGfx         'Holds positions of all gfx images
  138. Global gVBSpr(40) As VBSprite      'Holds all sprite details
  139.  
  140. '16 Bit API functions used by MVaders
  141. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  142. Declare Function SetBkColor& Lib "GDI" (ByVal hDC%, ByVal crColor&)
  143. Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
  144. Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
  145. Declare Function CreateBitmap% Lib "GDI" (ByVal nWidth%, ByVal nHeight%, ByVal nPlanes%, ByVal nBitCount%, ByVal lpBits As Any)
  146. Declare Function CreateCompatibleBitmap% Lib "GDI" (ByVal hDC%, ByVal nWidth%, ByVal nHeight%)
  147. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  148. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  149. Declare Function sndPlaySound Lib "MMSystem" (lpsound As Any, ByVal flag As Integer) As Integer
  150. Declare Function PtInRect Lib "User" (lpRect As RECT, ptRect As Any) As Integer
  151.  
  152. '32 Bit API functions
  153. 'Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  154. 'Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  155. 'Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  156. 'Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  157. 'Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  158. 'Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  159. 'Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  160. 'Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  161. 'Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  162.  
  163. Sub CenterForm (frm As Form)
  164.  
  165. 'Center the form on the screen
  166. frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
  167.  
  168. End Sub
  169.  
  170. Sub FreeAllSprites ()
  171.  
  172. Dim iMax As Integer
  173. Dim i As Integer
  174.  
  175. iMax = UBound(gVBSpr) - 1
  176.  
  177. For i = 0 To iMax
  178.     FreeSprite i
  179. Next i
  180.  
  181. End Sub
  182.  
  183. Sub FreeGfx ()
  184.  
  185. 'Purpose    To release all resources used to hold sprite graphics in memory.
  186. 'Entry      None, uses module level variables
  187. 'Exit       None, all resources released
  188. 'Notes      Clears all the following modal variables:
  189. '           miGfxDC, miGfxBmp, miGfxSav, miMaskDC, miMaskBmp, miMaskSav
  190.  
  191. Dim i As Integer
  192.  
  193. 'If there is a Gfx DC, free it
  194. If miGfxDC Then
  195.  
  196.     'Swap BitMap back in
  197.     i = SelectObject(miGfxDC, miGfxSav)
  198.  
  199.     'And free the DC
  200.     i = DeleteDC(miGfxDC)
  201.     miGfxDC = 0
  202.         
  203. End If
  204.  
  205. 'If there is a GfxBmp, free it
  206. If miGfxBmp Then
  207.     i = DeleteObject(miGfxBmp)
  208.     miGfxBmp = 0
  209. End If
  210.  
  211. 'Clear the swap pointer just to be complete
  212. miGfxSav = 0
  213.  
  214. 'If there is a Mask DC, free it
  215. If miMaskDC Then
  216.  
  217.     'Swap BitMap back in
  218.     i = SelectObject(miMaskDC, miMaskSav)
  219.  
  220.     'And free the DC
  221.     i = DeleteDC(miMaskDC)
  222.     miMaskDC = 0
  223.         
  224. End If
  225.  
  226. 'If there is a MaskBmp, free it
  227. If miMaskBmp Then
  228.     i = DeleteObject(miMaskBmp)
  229.     miMaskBmp = 0
  230. End If
  231.  
  232. 'Clear the swap pointer just to be complete
  233. miMaskSav = 0
  234.  
  235. End Sub
  236.  
  237. Sub FreeSprite (riId As Integer)
  238.  
  239. Dim i As Integer
  240.         
  241. 'Only proceed if sprite is used
  242. If gVBSpr(riId).iInUse Then
  243.  
  244.     'If there is a background DC, free it
  245.     If gVBSpr(riId).iSaveDC Then
  246.  
  247.         'Swap BitMap back in
  248.         i = SelectObject(gVBSpr(riId)